home *** CD-ROM | disk | FTP | other *** search
/ C/C++ 3D Game Tools / C-C++ 3D Game Tools.iso / ziptools / arj / af125.arj / AF.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-04-03  |  55.2 KB  |  1,382 lines
  1. Program AF; {Archive Finder}
  2. {$Define Err}
  3. {$R+}
  4.  
  5. {.$DEFINE ENGLISH}
  6.  
  7. Uses Crt,Dos{$IfDef Err},Err{$Endif};
  8.  
  9. Const motRep         = {$IfDef English} 'Directory';
  10.                        {$Else}          'Répertoire'; {$Endif}
  11.       motKo          = {$IfDef English} 'Kb';
  12.                        {$Else}          'Ko'; {$Endif}
  13. Const PatcherIci     : String[7] = 'Config:';
  14. Const SousRepAussi   : Boolean = True;
  15.       EcrireToutesA  : Boolean = False;
  16.       ArchivesSeules : Boolean = False;
  17.       NomComplet     : Boolean = False;
  18.       Globale        : Boolean = True;
  19.       PasLesArchives : Boolean = False;
  20.       VueRapide      : Boolean = False;
  21.       UniquementTot  : Boolean = False;
  22.       AffTotaux      : Boolean = False;
  23.       TousReps       : Boolean = True;
  24.       BelleVue       : Boolean = True;
  25.       UnCluster      : Word    = 0;
  26.       DefaultRep     = '\';
  27.       DefRep         : String[64] = DefaultRep;
  28.       Lecteurs       : String[26] = 'CDE';
  29.       DateMini       : LongInt = 0;
  30.       DateMaxi       : LongInt = $7FFFFFFF;
  31.       TailleMini     : LongInt = 0;
  32.       TailleMaxi     : LongInt = $7FFFFFFF;
  33. Type  Fichier        = Record
  34.                              Nam : String[12];
  35.                              Att : Byte;
  36.                              Dat : LongInt;
  37.                              Siz : LongInt;
  38.                        End;
  39. Const MaxFichiers    = 65000 div SizeOf(Fichier);
  40. Type  FichiersT      = Array[1..MaxFichiers] of Fichier;
  41. Var   Fichiers       : ^FichiersT;
  42.       NbFics         : Word;
  43.  
  44. Const MaxMask        = 20;
  45. Var   Mask           : Array[1..MaxMask] of String[128];
  46.       NbMasques      : Byte;
  47.  
  48.       NbArch         : Word;
  49.       Ext            : String[10];
  50.  
  51.       RepOriginal    : String;
  52.       KeepExit       : Pointer;
  53.       Redirige       : Boolean;
  54.       CrtS           : Text;
  55.       TotalFound     : LongInt;
  56.       SearchMask     : String;
  57.       TotDsk,TotDskR : LongInt;
  58.       TotArc,TotArcR : LongInt;
  59.       NumA,NumD      : Word;
  60.       NbArcFound     : Word; {nbre d'archives trouvées par -a}
  61.       ChercheTailleClust : Boolean; {spécial quand on ne sait pas sur quel
  62.                                      disk sera faite la recherche}
  63. Const Pile           : Byte = 0;
  64.  
  65.  
  66. Function OteBs(x:String):String;
  67. {Supprime le \ final si ce n'est pas le rep principal qui est spécifié}
  68. Begin
  69.      if (x<>'\') and (Length(x)>1) and (x[Length(x)]='\') then
  70.      if x[Pred(Length(x))]<>':' then dec(x[0]);
  71.      OteBs:=x;
  72. End;
  73.  
  74.  
  75. Function AjouteBs(x:String):String;
  76. {Ajoute un \ final}
  77. Begin
  78.      if x='' then x:='.\' else
  79.      if x[Length(x)]=':' then x:=x+'.\' else
  80.      if x[Length(x)]<>'\' then x:=x+'\';
  81.      AjouteBs:=x;
  82. End;
  83.  
  84.  
  85. Function Redir:Boolean;
  86. {pas encore implémenté la manière parfaite de détecter la redirection,
  87.  mais je dois avoir le source quelque part...}
  88. Var b : Array[1..256] of Byte;
  89. Begin
  90.      Move(Mem[PrefixSeg:0],B,SizeOf(b)); Redir:=B[26]<>1;
  91. End;
  92.  
  93.  
  94. Function ClusterSize(c:Char):Word;
  95. Type DPB = Record
  96.                  Numero     : Byte;
  97.                  SousUnite  : Byte;
  98.                  OctPSect   : Word;
  99.                  Interleave : Byte;
  100.                  SectPClust : Byte;
  101.                  Reserves   : Word;
  102.                  NbreDeFats : Byte;
  103.                  RootDir    : Word;
  104.                  PremSect   : Word;
  105.                  DernClust  : Word;
  106.                  SectPFat   : Byte;
  107.                  DataSect1  : Word;
  108.                  Driver     : Pointer;
  109.                  Media      : Byte;
  110.                  Flag       : Byte;
  111.                  NextDPB    : Pointer;
  112.            End;
  113. Var  p:^DPB;
  114.      b:Byte;
  115.      r:Registers;
  116. Begin
  117.      b:=Byte(UpCase(c)); ClusterSize:=0;
  118.      if b in [$41..$5A] then
  119.      Begin
  120.           b:=b-$40;
  121.           With r do
  122.           Begin
  123.                Ah:=$32; Dl:=b; MsDos(r);
  124.                p:=Ptr(ds,bx);
  125.                if Al=0 then
  126.                With p^ do ClusterSize:=(1 shl SectPClust)*OctPSect;
  127.           End;
  128.      End;
  129. End;
  130.  
  131.  
  132. Function FullSize(s:LongInt):LongInt;
  133. Var z:LongInt;
  134. Begin
  135.      z:=0;
  136.      if UnCluster>0 then
  137.      Begin
  138.           z:=(s div UnCluster)*UnCluster;
  139.           if s mod UnCluster<>0 then z:=z+UnCluster;
  140.      End;
  141.      FullSize:=z;
  142. End;
  143.  
  144.  
  145. Procedure ProcessKey;
  146. Var c:Char;
  147. Begin
  148.      if Keypressed then
  149.      Begin
  150.           c:=ReadKey;
  151.           if c in [#0,'',' '] then {^S,' '=pause, #0=tche de fonction}
  152.              Begin
  153.                   {$IfDef English}
  154.                   Write(CrtS,'≡≡≡ P a u s e ≡≡≡   Press a key to continue');
  155.                   {$Else}
  156.                   Write(CrtS,'≡≡≡ P a u s e ≡≡≡   Une touche pour continuer');
  157.                   {$Endif}
  158.                   c:=ReadKey;
  159.                   Write(CrtS,^M); ClrEol;
  160.              End;
  161.           if c in [^C,#27] then Halt;
  162.      End;
  163. End;
  164.  
  165.  
  166. Function Justify(x:String; b:Byte):String;
  167. Var Len:Byte absolute x;
  168. Begin
  169.      if Len>=b then Len:=b else While Len<b do x:=x+' '; Justify:=x;
  170. End;
  171.  
  172.  
  173. Function AffDate(d:DateTime):String;
  174. Const Months : Array[0..12] of String[3]
  175.              {$IfDef English}
  176.              = ('???','Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
  177.              {$Else}
  178.              = ('???','Jan','Fév','Mar','Avr','Mai','Jun','Jul','Aoû','Sep','Oct','Nov','Déc');
  179.              {$Endif}
  180. Var x,y,z:String[3];
  181. Begin
  182.      With d do
  183.      Begin
  184.           Str(Day:2,x); Str(Year mod 100:2,z); y:=Months[Month];
  185.      End;
  186.      {$IfDef ENGLISH}
  187.      AffDate:=y+' '+x+' '+z;
  188.      {$Else}
  189.      AffDate:=x+'-'+y+'-'+z;
  190.      {$Endif}
  191. End;
  192.  
  193.  
  194. Function AffHeure(d:DateTime):String;
  195. Var x,y:String[3];
  196. Begin
  197.      With d do
  198.      Begin
  199.           Str(Hour,x); if Hour<10 then x:='0'+x;
  200.           Str(Min,y);  if Min<10  then y:='0'+y;
  201.      End;
  202.      AffHeure:=x+':'+y;
  203. End;
  204.  
  205.  
  206. {$i C:\bp\cat\AF.INC}
  207.  
  208.  
  209. Function Check(s:String):Boolean;
  210. Var k:Byte;
  211.     Foo:Boolean;
  212. Begin
  213.      k:=0;
  214.      Repeat
  215.            Inc(k); if Pos('.',s)=0 then s:=s+'.'; Foo:=sCheck(Mask[k],s);
  216.      Until foo or (k=NbMasques);
  217.      Check:=foo;
  218. End;
  219.  
  220.  
  221. Procedure Reverse(Var l:LongInt);
  222. {pour les .SIT (Mac) les nombres hexa sont dans l'ordre inverse...}
  223. {Merci à Motorola et Intel de se mettre d'accord...}
  224. Var l1:LongInt;
  225. Begin
  226.      l1:=((l and $FF000000) shr 24) or ((l and $00FF0000) shr 8) or
  227.          ((l and $0000FF00) shl 8)  or ((l and $000000FF) shl 24);
  228.      l:=l1;
  229. End;
  230.  
  231.  
  232. Function OteRep(s:String):String;
  233. Var i:Byte;
  234. Begin
  235.      i:=Length(s); While (i>0) and (s[i]<>'\') and (s[i]<>':') do Dec(i);
  236.      if i>0 then Delete(s,1,i);
  237.      OteRep:=s;
  238. End;
  239.  
  240.  
  241. Procedure Examine(Nom:String; Taille:LongInt);
  242. {Examen d'une archive, quel que soit son type}
  243. Const MaxTampon = 200;
  244.       ZooId     = $FDC4A7DC;
  245. Type  ZooHdrTyp = Record
  246.                         Zoo_Text  : Array[1..20] of Char; { Nom du compacteur }
  247.                         Zoo_Tag   : LongInt;              { Identifie une archive Zoo }
  248.                         Zoo_Start : LongInt;              { Début des données }
  249.                         Zoo_Minus : LongInt;              { Vérification de concordance }
  250.                         Zoo_Major : Char;                 { Version n° }
  251.                         Zoo_Minor : Char;                 { Sous-version n° }
  252.                   End;
  253. Label Fin;      {- Oui, je sais}
  254. Var   f         : File;
  255.       Tampon    : Array[1..MaxTampon] of Byte;
  256.       Lu        : Word;
  257.       j1,j2     : Word; { pour compter la taille du nomfic et du commentaire }
  258.  
  259.       NomFic    : String;     { Nom du fichier       }
  260.       Algo      : String[5];  { Algo de compression  }
  261.       PSize     : LongInt;    { Packed Size          }
  262.       USize     : LongInt;    { Unpacked (real) size }
  263.       Date      : DateTime;   { Date du fichier      }
  264.  
  265.       Flusher   : LongInt;    { Nombre d'octets à sauter jusqu'au prochain fichier }
  266.       i         : Byte;
  267.       w         : Word;
  268.       Li        : LongInt;
  269.       Found     : Word;        { Nbr de fichiers trouvés }
  270.       Count     : LongInt;     { Position dans le fichier }
  271.       ZooHdr    : ZooHdrTyp;
  272.       PassEntry : Boolean;
  273.       NumOnLine : Byte;
  274.       SizeP,SizeU : LongInt;   { Tailles totales (Packed et Unpacked) }
  275.       Cmt       : Boolean;     { Est-ce un commentaire ? }
  276.       d1,d2     : LongInt;     {taille des Datas pour les .SIT}
  277.       TailleDisk: LongInt;     {Taille sur le disque}
  278.       St        : String;
  279.       KeepAttr  : Word;
  280. Begin
  281.      HighVideo;
  282.      Write(CrtS,^M);
  283.      if Redirige then ClrEol;
  284.      if ArchivesSeules and AffTotaux and not Redirige then Write(CrtS,Taille:9,'  ');
  285.      if NomComplet then Write(CrtS,Nom) else Write(CrtS,'Archive '+Nom);
  286.      ClrEol; Write(CrtS,^M);
  287.  
  288.      Inc(NbArch);
  289.      Found:=0; Assign(f,Nom); GetFAttr(f,KeepAttr); SetFAttr(f,0);
  290.      Reset(f,1); Lu:=0; Count:=0;
  291.      if Ext='ZOO' then
  292.      Begin
  293.           BlockRead(f,ZooHdr,SizeOf(ZooHdr),Lu);
  294.           if Lu<SizeOf(ZooHdr) then Goto Fin;
  295.           Count:=ZooHdr.Zoo_Start;
  296.      End else
  297.      if Ext='SIT' then
  298.      Begin
  299.           Count:=150; {moi non plus, je ne sais plus pourquoi}
  300.      End;
  301.      NumOnLine:=0; SizeP:=0; SizeU:=0; TailleDisk:=0;
  302.      Repeat
  303.            Seek(f,Count); PassEntry:=False; Cmt:=False;
  304.            ProcessKey;
  305.            BlockRead(f,Tampon[1],MaxTampon,Lu);
  306.            if Lu<26 then Goto Fin;
  307.  
  308.            if Ext='SIT' then
  309.            Begin
  310.                 Move(Tampon[3],NomFic,64);
  311.                 Move(Tampon[85],USize,4); Reverse(USize);
  312.                 Move(Tampon[93],PSize,4); Reverse(PSize);
  313.                 Move(Tampon[89],d1,4); Reverse(d1);
  314.                 Move(Tampon[97],d2,4); Reverse(d2);
  315.                 PSize:=PSize+d2; USize:=USize+d1;
  316.                 if Tampon[1]=0 then i:=Tampon[2] else i:=Tampon[1];
  317.                 Case i of
  318.                      0: Algo:='Stord';
  319.                      2: Algo:=' LZW ';
  320.                    else Algo:='?????';
  321.                 End;
  322.                 Li:=0;
  323.                 Flusher:=100+PSize+12; {Pourquoi 12 ? Bonne question}
  324.            End else
  325.            if Ext='ZOO' then
  326.            Begin
  327.                 Move(Tampon[1],Li,4);
  328.                 if Li<>ZooId then Goto Fin;
  329.                 Case Tampon[6] of
  330.                      0: Algo:='Store';
  331.                      1: Algo:=' Lzw ';
  332.                    else Begin Str(Tampon[6]:3,Algo); Algo:='? '+Algo; End;
  333.                 End;
  334.                 Move(Tampon[25],PSize,4);
  335.                 Move(Tampon[21],USize,4);
  336.                 i:=39; NomFic:='';
  337.                 While Tampon[i]<>0 do Begin NomFic:=NomFic+UpCase(Chr(Tampon[i])); Inc(i); End;
  338.                 Flusher:=0; Move(Tampon[7],Count,4);
  339.                 Move(Tampon[15],w,2); Li:=LongInt(w) shl 16;
  340.                 Move(Tampon[17],w,2); Li:=Li+w;
  341.            End else
  342.            if Ext='TPZ' then
  343.            Begin
  344.                 Case Tampon[25] of
  345.                      0: Algo:='inclu';
  346.                      1: Algo:='implo';
  347.                 End;
  348.                 Move(Tampon[26],USize,4);
  349.                 Move(Tampon[30],PSize,4);
  350.                 NomFic:='';
  351.                 i:=56;
  352.                 While (Tampon[i]<>32) And (i<56+67) do
  353.                 Begin
  354.                      NomFic:=NomFic+UpCase(Chr(Tampon[i])); Inc(i);
  355.                 End;
  356.                 i:=43;
  357.                 While (Tampon[i]<>32) And (i<43+12) do
  358.                 Begin
  359.                      NomFic:=NomFic+UpCase(Chr(Tampon[i])); Inc(i);
  360.                 End;
  361.                 Flusher:=PSize+122;
  362.                 Move(Tampon[36],Li,4);
  363.            End else
  364.            if Ext='LZH' then
  365.            Begin
  366.                 Move(Tampon[3],St[1],3); St[0]:=#3;
  367.                 if St<>'-lh' then Goto Fin;
  368.                 Move(Tampon[22],NomFic,Tampon[22]+1);
  369.                 Algo[0]:=#5; Move(Tampon[3],Algo[1],5);
  370.                 Move(Tampon[8],PSize,4);
  371.                 Move(Tampon[12],USize,4);
  372.                 Move(Tampon[18],w,2); Li:=LongInt(w) shl 16;
  373.                 Move(Tampon[16],w,2); Li:=Li+w;
  374.                 Flusher:=PSize+2+Tampon[1];
  375.            End else
  376.            if (Ext='ARJ') or ((Ext[1]='A') and (Ext[2] in ['0'..'9'])) then
  377.            Begin
  378.                 Move(Tampon[17],PSize,4);
  379.                 Move(Tampon[21],USize,4);
  380.                 i:=35; NomFic:=''; j1:=1;
  381.                 While Tampon[i]<>0 do Begin
  382.                   NomFic:=NomFic+Chr(Tampon[i]); Inc(i); Inc(j1);
  383.                 End;
  384.                 Case Tampon[10] of
  385.                      0: Algo:='Store';
  386.                    else Algo:='Met.'+Chr($30+Tampon[10]);
  387.                 End;
  388.                 Cmt:=Tampon[11]=2;
  389.                 Move(Tampon[3],w,2);
  390.                 Move(Tampon[13],Li,4);
  391.                 if Cmt then Begin
  392.                   Flusher:=4+w+4+2;
  393.                 End else Flusher:=14+w+PSize-4;
  394.            End else
  395.            if Ext='ZIP' then
  396.            Begin
  397.                 Move(Tampon[1],Li,4); if Li=$02014B50 then Goto Fin;
  398.                 Move(Tampon[9],w,2);
  399.                 Case w of
  400.                      0: Algo:='Stord';
  401.                      1: Algo:='Shrun';
  402.                      2: Algo:='Redu1';
  403.                      3: Algo:='Redu2';
  404.                      4: Algo:='Redu3';
  405.                      5: Algo:='Redu4';
  406.                      6: Algo:='Implo';
  407.                      7: Algo:='Token';
  408.                      8: Algo:='Defla'; {or EXTRA compression}
  409.                    else Str(w:5,Algo);
  410.                 End;
  411.                 Move(Tampon[13],w,2); Li:=LongInt(w) shl 16;
  412.                 Move(Tampon[11],w,2); Li:=Li+w;
  413.                 Move(Tampon[19],PSize,4);
  414.                 Move(Tampon[23],USize,4);
  415.                 Move(Tampon[27],w,2); if w>255 then w:=255;
  416.                 NomFic[0]:=Chr(w); Move(Tampon[31],NomFic[1],w);
  417.                 Flusher:=30+w+PSize;
  418.                 Move(Tampon[29],w,2);
  419.                 Flusher:=Flusher+w;
  420.            End else
  421.            if (Ext='ARC') or (Ext='PAK') then
  422.            Begin
  423.                 Case Tampon[2] of
  424.                      0: Goto Fin;
  425.                      1: Algo:='Stor1';
  426.                      2: Algo:='Stor2';
  427.                      3: Algo:='Packd';
  428.                      4: Algo:='Squzd';
  429.                      5: Algo:='Crun1';
  430.                      6: Algo:='Crun2';
  431.                      7: Algo:='Crun3';
  432.                      8: Algo:='Crun4';
  433.                      9: Algo:='Sqash';
  434.                    else Algo:='  ?  ';
  435.                 End;
  436.  
  437.                 i:=3; NomFic:='';
  438.                 While Tampon[i]<>0 do Begin NomFic:=NomFic+Chr(Tampon[i]); Inc(i); End;
  439.                 Move(Tampon[16],PSize,4);
  440.                 if Tampon[2]=1 then USize:=PSize
  441.                                else Move(Tampon[26],USize,4);
  442.                 if Tampon[2]=1 then Flusher:=25+PSize
  443.                                else Flusher:=29+Psize;
  444.                 Move(Tampon[18],Li,4);
  445.            End;
  446.            UnPackTime(Li,Date);
  447.  
  448.            While Pos('/',NomFic)<>0 do NomFic[Pos('/',NomFic)]:='\';
  449.            if (Li>=DateMini) and (Li and $FFFF0000<=DateMaxi) and
  450.               (USize>=TailleMini) and (USize<=TailleMaxi) then
  451.            if (NomFic<>'') and not Cmt then if Check(OteRep(NomFic)) then
  452.            Begin
  453.                 if Found=0 then
  454.                 Begin
  455.                      if Redirige and (ArchivesSeules or not EcrireToutesA) then
  456.                        if NomComplet then WriteLn(Nom)
  457.                                      else WriteLn('Archive '+Nom);
  458.                      if not Redirige then Begin LowVideo; WriteLn(CrtS); End;
  459.                      if not (VueRapide or UniquementTot or NomComplet or ArchivesSeules) then
  460.                      Begin
  461.                           {$IfDef English}
  462.                           WriteLn('File name                      Methd UnpSize  PakSize Prct    Date    Time ');
  463.                           {$Else}
  464.                           WriteLn('Nom du fichier                 Méthd TRéelle  TComprs Prct    Date    Heure');
  465.                           {$Endif}
  466.                           WriteLn('------------------------------ ----- -------  ------- ----  --------- -----');
  467.                      End;
  468.                 End;
  469.                 Inc(Found); Inc(TotalFound); Inc(SizeU,USize); Inc(SizeP,PSize);
  470.                 Inc(NumA);
  471.                 Inc(TotArc,USize);
  472.                 Inc(TotArcR,FullSize(USize));
  473.                 TailleDisk:=TailleDisk+FullSize(USize);
  474.                 if not (UniquementTot or ArchivesSeules) then
  475.                 if VueRapide then
  476.                 Begin
  477.                      Inc(NumOnLine);
  478.                      While Pos('\',NomFic)<>0 do Delete(NomFic,1,Pos('\',NomFic));
  479.                      Write('  '+Justify(NomFic,12));
  480.                      if NumOnLine=5 then
  481.                      Begin
  482.                           WriteLn(' '); NumOnLine:=0;
  483.                      End else Write('  ');
  484.                 End else
  485.                 if NomComplet
  486.                    then WriteLn(NomFic)
  487.                    else Begin
  488.                              Write(Justify(NomFic,30),' '+Algo,USize:8,' ',PSize:8,' ');
  489.                              if USize>0 then Write(LongInt(PSize)*100 div USize:3,'%')
  490.                                         else Write('100%');
  491.                              if Li<>0 then Write('  ',AffDate(Date),' ',AffHeure(Date));
  492.                              WriteLn;
  493.                         End;
  494.            End;
  495.            if ArchivesSeules and (found>0) then Begin
  496.              Inc(NbArcFound); Goto Fin;
  497.            End;
  498.            Inc(Count,Flusher);
  499.      Until false;
  500. Fin: Close(f);
  501.      SetFAttr(f,KeepAttr);
  502.      if VueRapide and (NumOnLine>0) then WriteLn;
  503.      if Found>0 then if NomComplet and not ArchivesSeules then WriteLn else
  504.      if not ArchivesSeules then
  505.      if AffTotaux then
  506.      Begin
  507.           if not (VueRapide or UniquementTot) then
  508.              WriteLn('------------------------------       -------  -------');
  509.           if TailleDisk=0 then St:='' else
  510.           Begin
  511.                Str(TailleDisk,St);
  512.                St:='('+St+')';
  513.           End;
  514.           if VueRapide then i:=24 else i:=36;
  515.           if Found=1 then
  516.             {$IfDef ENGLISH}
  517.             Write(Justify('1 file '+St,i)) else
  518.             {$Else}
  519.             Write(Justify('1 fichier '+St,i)) else
  520.             {$Endif}
  521.           Begin
  522.                Str(Found,Algo);
  523.                {$IfDef ENGLISH}
  524.                Write(Justify(Algo+' files '+St,i));
  525.                {$Else}
  526.                Write(Justify(Algo+' fichiers '+St,i));
  527.                {$Endif}
  528.           End;
  529.           WriteLn(SizeU:8,' ',SizeP:8,' ',SizeP*100 div SizeU:3,'%');
  530.           WriteLn;
  531.      End else if Found>0 then WriteLn;
  532. End;
  533.  
  534.  
  535. Function WriteAttr(b:Byte):String;
  536. Var x:String;
  537. Begin
  538.      x:='';
  539.      if b and $1 =$1  then x:=x+'r' else x:=x+' ';
  540.      if b and $2 =$2  then x:=x+'h' else x:=x+' ';
  541.      if b and $4 =$4  then x:=x+'s' else x:=x+' ';
  542.      if b and $20=$20 then x:=x+'a' else x:=x+' ';
  543.      WriteAttr:=x;
  544. End;
  545.  
  546.  
  547. Var TmpStr    : String; {Cherche est récursive !}
  548.     Dt        : DateTime;
  549.     i         : Word;
  550.     NumOnLine : Byte;
  551.     TotalSize : LongInt;
  552.     TotalDisk : LongInt;
  553.     St2       : String;
  554.  
  555. Procedure Cherche(Rep:ComStr);
  556. {Recherche récursive sur les fichiers du disque.}
  557. Type RepTypPtr = ^RepTyp;
  558.      RepTyp    = Record
  559.                        n:RepTypPtr; {pointe sur le prochain}
  560.                        s:String[12];
  561.                  End;
  562. Var Sr:SearchRec;
  563.     FirstRep,ChnRep:RepTypPtr;
  564. Begin
  565.      Inc(Pile);
  566.      {$i-} ChDir(Rep); {$i+}
  567.      if IoResult<>0 then
  568.      Begin
  569.           if EcrireToutesA and not NomComplet then
  570.           Begin
  571.                {$IfDef English}
  572.                TmpStr:='Invalid directory '+Rep;
  573.                {$Else}
  574.                TmpStr:='Répertoire '+Rep+' invalide';
  575.                {$Endif}
  576.                HighVideo;
  577.                if Redirige then Begin Write(TmpStr); ClrEol; WriteLn; End
  578.                            else Begin
  579.                                      Write(CrtS,^M+TmpStr); ClrEol;
  580.                                      LowVideo; WriteLn(CrtS);
  581.                                 End;
  582.           End;
  583.           Exit;
  584.      End;
  585.      GetDir(0,TmpStr); if TmpStr[Length(TmpStr)]<>'\' then TmpStr:=TmpStr+'\';
  586.      if ChercheTailleClust then
  587.      Begin
  588.           ChercheTailleClust:=false; UnCluster:=ClusterSize(TmpStr[1]);
  589.      End;
  590.      HighVideo;
  591.      Write(CrtS,^M+motRep+' '+OteBS(TmpStr)); ClrEol; Write(CrtS,^M);
  592.      LowVideo;
  593.      NbFics:=0;
  594.  
  595.      FindFirst(SearchMask,AnyFile-VolumeId,Sr); ProcessKey;
  596.  
  597.      if TousReps then
  598.      Begin
  599.           New(ChnRep); FillChar(ChnRep^,Sizeof(ChnRep^),0); FirstRep:=ChnRep;
  600.      End;
  601.  
  602.      if DosError=0 then
  603.      With Sr do While DosError=0 do
  604.      Begin
  605.           if Attr and Directory<>0 then
  606.           Begin
  607.                if TousReps and (Name<>'.') and (Name<>'..') then
  608.                Begin
  609.                     ChnRep^.s:=Name; New(ChnRep^.n);
  610.                     ChnRep:=ChnRep^.n;  FillChar(ChnRep^,SizeOf(ChnRep^),0);
  611.                End;
  612.           End else
  613.           Begin
  614.                if Time<0 then Time:=0;
  615.                if Globale and (Time>=DateMini)
  616.                           and (Time and $FFFF0000<=DateMaxi)
  617.                           and (Size>=TailleMini)
  618.                           and (Size<=TailleMaxi)
  619.                           and Check(Name)
  620.                           then
  621.                Begin
  622.                     Inc(NbFics); Inc(TotalFound); Inc(NumD);
  623.                     With Fichiers^[NbFics] do
  624.                     Begin
  625.                          Nam:=Name; Siz:=Size; Dat:=Time; Att:=Attr;
  626.                          Inc(TotDsk,Size); Inc(TotDskR,FullSize(Size));
  627.                     End;
  628.                End;
  629.                if not PasLesArchives then
  630.                Begin
  631.                     if Pos('.',Name)<>0 then Ext:=Copy(Name,Pos('.',Name)+1,3)
  632.                                         else Ext:='';
  633.                     if (Ext='LZH') or (Ext='ARJ') or (Ext='ZIP') or (Ext='ARC') or
  634.                        (Ext='PAK') or (Ext='ZOO') or (Ext='SIT') or (Ext='TPZ')
  635.                        or ((Ext[1]='A') and (Ext[2] in ['0'..'9']) and (Ext[3] in ['0'..'9']))
  636.                        then Examine(TmpStr+Name,Size)
  637.                End;
  638.           End;
  639.           ProcessKey; FindNext(Sr);
  640.      End;
  641.      if NbFics>0 then
  642.      Begin
  643.           NumOnLine:=0; HighVideo; TotalSize:=0; TotalDisk:=0;
  644.           if BelleVue or NomComplet then Begin LowVideo; ClrEol; End else
  645.           if Redirige then Begin Write(motRep+' '+OteBs(TmpStr)); ClrEol; WriteLn; End
  646.                       else Begin
  647.                                 Write(CrtS,^M+MotRep+' '+OteBs(TmpStr)); ClrEol;
  648.                                 LowVideo; WriteLn(CrtS);
  649.                            End;
  650.           LowVideo;
  651.           if not (BelleVue or NomComplet or VueRapide or UniquementTot) then
  652.           Begin
  653.                {$IfDef English}
  654.                WriteLn('File name       Size     Date     Time ');
  655.                {$Else}
  656.                WriteLn('Nom fichier    Taille    Date     Heure');
  657.                {$Endif}
  658.                WriteLn('------------  -------  ---------  -----');
  659.           End;
  660.           For i:=1 to NbFics do With Fichiers^[i] do
  661.           Begin
  662.                TotalSize:=TotalSize+Siz; TotalDisk:=TotalDisk+FullSize(Siz);
  663.                ProcessKey;
  664.                UnpackTime(Dat,DT);
  665.                if NomComplet then WriteLn(AjouteBs(OteBs(TmpStr))+Nam) else
  666.                if not UniquementTot then
  667.                if BelleVue then
  668.                   WriteLn(Justify(Nam,12)+' ',Siz:8,'  '+AffDate(Dt)+'  '+
  669.                           AffHeure(Dt)+'  '+AjouteBs(OteBs(TmpStr))) else
  670.                if VueRapide then
  671.                Begin
  672.                     Inc(NumOnLine);
  673.                     Write('  '+Justify(Nam,12));
  674.                     if NumOnLine=5 then
  675.                     Begin
  676.                          WriteLn; NumOnLine:=0;
  677.                     End else Write('  ');
  678.                End else
  679.                   WriteLn(Justify(Nam,12)+' ',Siz:8,'  '+AffDate(Dt)+'  '+AffHeure(Dt));
  680.           End;
  681.           if VueRapide and (NumOnLine<>0) then WriteLn;
  682.           if AffTotaux then
  683.           Begin
  684.                if not (VueRapide or UniquementTot) then
  685.                   WriteLn('              -------');
  686.                if NbFics=1 then {$IfDef English}Write(Justify('1 file',13))
  687.                                 {$Else}Write(Justify('1 fichier',13)){$Endif}
  688.                            else
  689.                Begin
  690.                     Str(NbFics,St2);
  691.                     {$IfDef English}
  692.                     Write(Justify(St2+' files',13));
  693.                     {$Else}
  694.                     Write(Justify(St2+' fichiers',13));
  695.                     {$Endif}
  696.                End;
  697.                WriteLn(' ',TotalSize:7,'  (',TotalDisk,')');
  698.           End;
  699.           if not NomComplet then WriteLn;
  700.      End else if (not ArchivesSeules and EcrireToutesA) then
  701.          if Redirige then Writeln(motRep+' '+OteBs(TmpStr))
  702.                      else Begin LowVideo; WriteLn(CrtS); End;
  703.      if SousRepAussi then
  704.      Begin
  705.           if not TousReps then
  706.           Begin
  707.                FindFirst('*.',Directory,Sr);
  708.                With Sr do While DosError=0 do
  709.                Begin
  710.                     if (Attr and Directory=Directory) and (Name<>'.') and (Name<>'..') then
  711.                        Cherche(Name);
  712.                     FindNext(Sr);
  713.                End;
  714.           End else
  715.           if (FirstRep^.n<>Nil) or (FirstRep^.s<>'') then
  716.           Begin
  717.                ChnRep:=FirstRep;
  718.                While ChnRep<>Nil do
  719.                Begin
  720.                     if ChnRep^.s<>'' then Cherche(ChnRep^.s);
  721.                     FirstRep:=ChnRep; ChnRep:=ChnRep^.n; Dispose(FirstRep);
  722.                End;
  723.           End else Dispose(FirstRep);
  724.      End;
  725.      Dec(Pile); if Pile>0 then ChDir('..');
  726.      Write(CrtS,^M); ClrEol; LowVideo;
  727. End;
  728.  
  729.  
  730. Function PlusMoins(Var x:String):Byte;
  731. {Gestion des paramètres de la ligne de commande}
  732. Begin
  733.      Delete(x,1,1);
  734.      if x[1]='-' then Begin PlusMoins:=0; Delete(x,1,1); End else
  735.      if x[1]='+' then Begin PlusMoins:=1; Delete(x,1,1); End else
  736.                             PlusMoins:=2;
  737. End;
  738.  
  739.  
  740. Function LisDate(Var s:String):LongInt;
  741. Var Dt:DateTime;
  742.     L:LongInt;
  743.     dow:Word;
  744.     ErrVal:Integer;
  745. Begin
  746.      Delete(s,1,1); L:=-1;
  747.      With Dt do
  748.      if Length(s)>=6 then
  749.      Begin
  750.           {$IfDef English}
  751.           Val(Copy(s,3,2),Day,ErrVal); if ErrVal<>0 then Day:=1;
  752.           Val(Copy(s,1,2),Month,ErrVal); if ErrVal<>0 then Month:=1;
  753.           {$Else}
  754.           Val(Copy(s,1,2),Day,ErrVal); if ErrVal<>0 then Day:=1;
  755.           Val(Copy(s,3,2),Month,ErrVal); if ErrVal<>0 then Month:=1;
  756.           {$Endif}
  757.           Val(Copy(s,5,2),Year,ErrVal); if ErrVal<>0 then Year:=1;
  758.           Year:=Year+1900; While Year<1980 do Inc(Year,100);
  759.           Hour:=0; Min:=0; Sec:=0;
  760.           PackTime(Dt,L); Delete(s,1,6);
  761.      End else
  762.      if (s='') or (s[1]<'0') or (s[1]>'9') then
  763.      Begin
  764.           GetDate(Year,Month,Day,Dow); Hour:=0; Min:=0; Sec:=0;
  765.           While Year<1980 do Inc(Year,100);
  766.           PackTime(Dt,l);
  767.      End else {$IfDef English}
  768.               WriteLn('/D invalid date (mmddyy)');
  769.               {$Else}
  770.               WriteLn('/D date invalide (JJMMYY)');
  771.               {$Endif}
  772.      LisDate:=L;
  773. End;
  774.  
  775.  
  776. Function ShowDate(l:LongInt):String;
  777. Var s,x:String[6];
  778.     Dt:DateTime;
  779. Begin
  780.      UnpackTime(l,Dt);
  781.      With Dt do Begin
  782.        s:='';
  783.        {$IfDef English}
  784.        if Month<10 then s:=s+'0'; Str(Month,x); s:=s+x;
  785.        if Day<10   then s:=s+'0'; Str(Day,x); s:=s+x;
  786.        {$Else}
  787.        if Day<10   then s:=s+'0'; Str(Day,x); s:=s+x;
  788.        if Month<10 then s:=s+'0'; Str(Month,x); s:=s+x;
  789.        {$Endif}
  790.        Year:=Year mod 100; if Year<10 then s:=s+'0'; Str(Year,x); s:=s+x;
  791.      End;
  792.      ShowDate:=s;
  793. End;
  794.  
  795.  
  796. Function LisTaille(Var x:String):LongInt;
  797. {Extraction de la taille après /i±999}
  798. Var s:String;
  799.     L:LongInt;
  800.     ErrVal:Integer;
  801. Begin
  802.      Delete(x,1,1); LisTaille:=-1;
  803.      if x<>'' then
  804.      Begin
  805.           s:='';
  806.           While (x<>'') and (x[1]>='0') and (x[1]<='9') do
  807.           Begin
  808.                s:=s+x[1]; Delete(x,1,1);
  809.           End;
  810.           Val(s,L,ErrVal); if ErrVal<>0 then L:=-1;
  811.           LisTaille:=L;
  812.      End;
  813. End;
  814.  
  815.  
  816. Procedure LisParametres;
  817. Const Pm : Array[Boolean] of Char = ('-','+');
  818. Var Msk,Ext,x,y,z,t,Rep:String;
  819.     i,j:Byte;
  820.     Stupid,DefRepSet,AffHelp,Debug:Boolean; {Si /R a déjà été spécifié}
  821. Begin
  822.      SearchMask:='*.*'; NbMasques:=0; DefRepSet:=False; Rep:=''; Stupid:=False;
  823.      ChercheTailleClust:=False; AffHelp:=False; Debug:=False;
  824.      if ParamCount>0 then
  825.      Begin
  826.           For i:=1 to ParamCount do
  827.           Begin
  828.                x:=ParamStr(i); For j:=1 to Length(x) do x[j]:=UpCase(x[j]);
  829.                if x[1]='?' then AffHelp:=True else
  830.                if (x[1]='/') or (x[1]='-') then
  831.                Begin
  832.                     Delete(x,1,1);
  833.                     While x<>'' do
  834.                     Case x[1] of
  835.                          'A' : Begin
  836.                                     Case PlusMoins(x) of
  837.                                          0: ArchivesSeules:=False;
  838.                                          1: ArchivesSeules:=True;
  839.                                          2: ArchivesSeules:=not ArchivesSeules;
  840.                                     End;
  841.                                     if ArchivesSeules then
  842.                                     Begin
  843.                                          EcrireToutesA:=True; Globale:=False;
  844.                                     End;
  845.                                End;
  846.                          'B' : Case PlusMoins(x) of
  847.                                     0: BelleVue:=False;
  848.                                     1: BelleVue:=True;
  849.                                     2: BelleVue:=not BelleVue;
  850.                                End;
  851.                          'C' : Begin
  852.                                     Case PlusMoins(x) of
  853.                                          0: SousRepAussi:=False;
  854.                                          1: SousRepAussi:=True;
  855.                                          2: SousRepAussi:=not SousRepAussi;
  856.                                     End;
  857.                                     if not DefRepSet then
  858.                                     Begin
  859.                                          DefRep:='';
  860.                                          DefRepSet:=True;
  861.                                          GetDir(0,y); Lecteurs:=y[1];
  862.                                     End;
  863.                                End;
  864.                          'D' : Begin
  865.                                     Delete(x,1,1);
  866.                                     Case x[1] of
  867.                                          '+': DateMini:=LisDate(x);
  868.                                          '-': DateMaxi:=LisDate(x);
  869.                                          '=': Begin
  870.                                                    DateMini:=LisDate(x);
  871.                                                    DateMaxi:=DateMini;
  872.                                               End;
  873.                                          else {$IfDef English} WriteLn('/D incorrect syntax');
  874.                                               {$Else} WriteLn('/D syntaxe incorrecte'); {$Endif}
  875.                                     End;
  876.                                End;
  877.                          'E' : Case PlusMoins(x) of
  878.                                     0: EcrireToutesA:=False;
  879.                                     1: EcrireToutesA:=True;
  880.                                     2: EcrireToutesA:=not EcrireToutesA;
  881.                                End;
  882.                          'F' : Case PlusMoins(x) of
  883.                                     0: AffTotaux:=False;
  884.                                     1: AffTotaux:=True;
  885.                                     2: AffTotaux:=not AffTotaux;
  886.                                End;
  887.                          'G' : Case PlusMoins(x) of
  888.                                     0: Globale:=False;
  889.                                     1: Globale:=True;
  890.                                     2: Globale:=not Globale;
  891.                                End;
  892.                          'I' : Begin
  893.                                     Delete(x,1,1);
  894.                                     Case x[1] of
  895.                                          '+': TailleMini:=LisTaille(x);
  896.                                          '-': TailleMaxi:=LisTaille(x);
  897.                                          '=': Begin
  898.                                                    TailleMini:=LisTaille(x);
  899.                                                    TailleMaxi:=TailleMini;
  900.                                               End;
  901.                                          else {$IfDef English} WriteLn('/I incorrect syntax');
  902.                                               {$Else} WriteLn('/I syntaxe incorrecte'); {$Endif}
  903.                                     End;
  904.                                End;
  905.                          'L' : Begin
  906.                                     Delete(x,1,1);
  907.                                     if x<>'' then
  908.                                     if x='0' then Begin
  909.                                       GetDir(0,y); Lecteurs:=y[1];
  910.                                     End else Lecteurs:=x;
  911.                                     x:='';
  912.                                End;
  913.                          'M' : Begin
  914.                                     Delete(x,1,1);
  915.                                     if x<>'' then
  916.                                     Begin
  917.                                          FSplit(x,y,z,t);
  918.                                          if y<>'' then DefRep:=OteBS(y);
  919.                                          if Pos(':',y)<>0 then Begin
  920.                                            Lecteurs:=y[1];
  921.                                          End;
  922.                                          SearchMask:=z+t; x:='';
  923.                                     End;
  924.                                End;
  925.                          'N' : Case PlusMoins(x) of
  926.                                     0: NomComplet:=False;
  927.                                     1: NomComplet:=True;
  928.                                     2: NomComplet:=not NomComplet;
  929.                                End;
  930.                          'P' : Case PlusMoins(x) of
  931.                                     0: PasLesArchives:=False;
  932.                                     1: PasLesArchives:=True;
  933.                                     2: PasLesArchives:=not PasLesArchives;
  934.                                End;
  935.                          'R' : Begin
  936.                                     Delete(x,1,1);
  937.                                     if x<>'' then
  938.                                     Begin
  939.                                          DefRep:=x; DefRepSet:=True;
  940.                                          if x[2]=':' then Lecteurs:=x[1];
  941.                                          x:='';
  942.                                     End;
  943.                                End;
  944.                          'S' : Case PlusMoins(x) of
  945.                                     0: SousRepAussi:=False;
  946.                                     1: SousRepAussi:=True;
  947.                                     2: SousRepAussi:=not SousRepAussi;
  948.                                End;
  949.                          'T' : Begin
  950.                                     Delete(x,1,1);
  951.                                     if x<>'' then
  952.                                     Begin
  953.                                          AffTotaux:=True;
  954.                                          if x[1]='0' then
  955.                                          Begin
  956.                                               ChercheTailleClust:=True;
  957.                                               Delete(x,1,1);
  958.                                          End else
  959.                                          if x[1] in ['A'..'Z'] then
  960.                                          Begin
  961.                                               UnCluster:=ClusterSize(x[1]);
  962.                                               Delete(x,1,1);
  963.                                               ChercheTailleClust:=False;
  964.                                          End else
  965.                                          if x[1]='-' then
  966.                                          Begin
  967.                                               Delete(x,1,1); ChercheTailleClust:=False;
  968.                                          End;
  969.                                     End;
  970.                                End;
  971.                          'U' : Case PlusMoins(x) of
  972.                                     0: UniquementTot:=False;
  973.                                     1: UniquementTot:=True;
  974.                                     2: UniquementTot:=not UniquementTot;
  975.                                End;
  976.                          'W' : Case PlusMoins(x) of
  977.                                     0: VueRapide:=False;
  978.                                     1: VueRapide:=True;
  979.                                     2: VueRapide:=not VueRapide;
  980.                                End;
  981.                          '*' : Case PlusMoins(x) of
  982.                                     0: TousReps:=False;
  983.                                     1: TousReps:=True;
  984.                                     2: TousReps:=not TousReps;
  985.                                End;
  986.                          '#' : Case PlusMoins(x) of
  987.                                     0: Redirige:=False;
  988.                                     1: Redirige:=True;
  989.                                     2: Redirige:=not Redirige;
  990.                                End;
  991.                          '?' : Begin Delete(x,1,1); AffHelp:=True; End;
  992.                          ')' : Begin Delete(x,1,1); Debug:=True;   End;
  993.                           else Delete(x,1,1);
  994.                     End;
  995.                End else
  996.                Begin
  997.                     { On fait le FSplit à la main pour avoir des MASK et EXT
  998.                       ayant des tailles supérieures aux normes DOS. Par
  999.                       exemple: AF *LIS*MOI*.V*D* }
  1000.                     if x[Length(x)]=':' then x:=x+'.\'; j:=Length(x);
  1001.                     While (j>0) and (x[j]<>'\') and (x[j]<>':') do Dec(j);
  1002.                     if j>0 then
  1003.                     Begin
  1004.                          if (j>1) then Rep:=Copy(x,1,j-1) else
  1005.                          if j=1 then Rep:='\';
  1006.                          if j<>Length(x) then x:=Copy(x,j+1,Length(x)-j)
  1007.                                          else x:='';
  1008.                     End;
  1009.                     j:=Pos('.',x);
  1010.                     if j>0 then
  1011.                     Begin
  1012.                          Msk:=Copy(x,1,j-1); Ext:=Copy(x,j,Length(x)-j+1);
  1013.                     End else
  1014.                     Begin
  1015.                          Msk:=x; Ext:='';
  1016.                     End;
  1017.                     While Pos('**',Msk)<>0 do Delete(Msk,Pos('**',Msk),1);
  1018.                     { on agrandis la recherche dans la limite du raisonnable }
  1019.                     if (Msk[Length(Msk)]<>'*') and (Ext='') then Msk:=Msk+'*';
  1020.                     Msk:=Msk+Ext;
  1021.                     if NbMasques=MaxMask then
  1022.                        {$IfDef English}
  1023.                        WriteLn('WARNING: only ',MaxMask,' will be used !') else
  1024.                        {$Else}
  1025.                        WriteLn('ATTENTION: seulement ',MaxMask,' pris en compte !') else
  1026.                        {$Endif}
  1027.                        Begin
  1028.                             Inc(NbMasques); Mask[NbMasques]:=Msk;
  1029.                        End;
  1030.                End;
  1031.           End;
  1032.      End;
  1033.      if Globale and PasLesArchives and not DefRepSet and (Rep<>'')
  1034.         then DefRep:=Rep;
  1035.      if UniquementTot then
  1036.      Begin
  1037.           if not AffTotaux then
  1038.           Begin
  1039.                AffTotaux:=True; ChercheTailleClust:=True;
  1040.           End;
  1041.           BelleVue:=False;
  1042.      End;
  1043.      if (ArchivesSeules and PasLesArchives) or
  1044.         (not Globale and PasLesArchives) then
  1045.      Begin
  1046.           Stupid:=True;
  1047.           {$IfDef English}
  1048.           WriteLn('What a stupid request ! Try option /)');
  1049.           {$Else}
  1050.           WriteLn('Quelle requête idiote ! Essayez l''option /)');
  1051.           {$Endif}
  1052.      End;
  1053.      if ArchivesSeules then Globale:=False;
  1054.      if NbMasques=0 then
  1055.      Begin
  1056.           Inc(NbMasques); Mask[1]:='*';
  1057.      End;
  1058.      if PasLesArchives and Globale and not TousReps and (NbMasques=1) then
  1059.      Begin
  1060.           i:=Pos('*',Mask[1]);
  1061.           if (i=0) or (i<>Length(Mask[1])) or (Mask[1][Succ(i)]<>'.')
  1062.              then SearchMask:=Mask[1] else TousReps:=True;
  1063.      End;
  1064.      if Pos('.',SearchMask)=0 then
  1065.      Begin
  1066.           if SearchMask[Length(SearchMask)]<>'*' then SearchMask:=SearchMask+'*';
  1067.           SearchMask:=SearchMask+'.*';
  1068.      End;
  1069.      if DefRep[Length(DefRep)]=':' then DefRep:=DefRep+'.\';
  1070.      if AffHelp or Debug then
  1071.      Begin
  1072.           if not Debug then
  1073.           Begin
  1074.                {$IfDef English}
  1075.                WriteLn('Usage: AF [Mask*.*] [*Mask*] [/Parameter(s)] [-Parameter(s)]');
  1076.                {$Else}
  1077.                WriteLn('Usage: AF [Masque*.*] [*Masque*] [/Paramètre(s)] [-Paramètre(s)]');
  1078.                {$Endif}
  1079.                WriteLn;
  1080.           End;
  1081.           {$IfDef English}
  1082.           Write('  /a '+PM[ArchivesSeules]+'  Archive names only        ');
  1083.           Write('  /b '+PM[BelleVue]+'  Beautiful vue');
  1084.           WriteLn;
  1085.           Write('  /c    Current directory only    ');
  1086.           Write('  /d... Date (/d+311291 /d=010191)');
  1087.           WriteLn;
  1088.           Write('  /e '+PM[EcrireToutesA]+'  Every name written        ');
  1089.           Write('  /f '+PM[AffTotaux]+'  Full statistics         ');
  1090.           WriteLn;
  1091.           Write('  /g '+PM[Globale]+'  Global search             ');
  1092.           Write('  /i... sIze (/i+1024 /i-2048)  ');
  1093.           WriteLn;
  1094.           Write('  /l... Look drives: '+Justify(Lecteurs,12)+' ');
  1095.           Write('  /m... Mask for archives: '+Justify(SearchMask,16)+' ');
  1096.           WriteLn;
  1097.           Write('  /n '+PM[NomComplet]+'  Names only');
  1098.           WriteLn;
  1099.           Write('  /p '+PM[PasLesArchives]+'  skiP archives             ');
  1100.           Write('  /r... staRting at directory');
  1101.           WriteLn;
  1102.           Write('  /s '+PM[SousRepAussi]+'  Subdirs also              ');
  1103.           Write('  /t... True size on disk');
  1104.           WriteLn;
  1105.           Write('  /u '+PM[UniquementTot]+'  show only totals          ');
  1106.           Write('  /w '+PM[VueRapide]+'  Wide display       ');
  1107.           WriteLn;
  1108.           Write('  /* '+PM[TousReps]+'  all directories');
  1109.          {$Else}
  1110.           Write('  /a '+PM[ArchivesSeules]+'  noms Archives seulement   ');
  1111.           Write('  /b '+PM[BelleVue]+'  Belle vue');
  1112.           WriteLn;
  1113.           Write('  /c    dans Ce répertoire        ');
  1114.           Write('  /d... date (/d+'+ShowDate(DateMini)+' /d-'+ShowDate(DateMaxi)+')');
  1115.           WriteLn;
  1116.           Write('  /e '+PM[EcrireToutesA]+'  tous les noms             ');
  1117.           Write('  /f '+PM[AffTotaux]+'  aFficher les totaux     ');
  1118.           WriteLn;
  1119.           Write('  /g '+PM[Globale]+'  recherche Globale         ');
  1120.           Write('  /i... taille (/i+1024 /i-2048)');
  1121.           WriteLn;
  1122.           Write('  /l... Lecteurs: '+Justify(Lecteurs,12)+'    ');
  1123.           Write('  /m... Masque: '+Justify(SearchMask,16)+' ');
  1124.           WriteLn;
  1125.           Write('  /n '+PM[NomComplet]+'  Nom complets');
  1126.           WriteLn;
  1127.           Write('  /p '+PM[PasLesArchives]+'  Pas les archives          ');
  1128.           Write('  /r... Répertoire de départ');
  1129.           WriteLn;
  1130.           Write('  /s '+PM[SousRepAussi]+'  Sous-répertoires          ');
  1131.           Write('  /t... Taille réelle');
  1132.           WriteLn;
  1133.           Write('  /u '+PM[UniquementTot]+'  totaux Uniquement         ');
  1134.           Write('  /w '+PM[VueRapide]+'  affichage ''Wide''');
  1135.           WriteLn;
  1136.           Write('  /* '+PM[TousReps]+'  tous les répertoires');
  1137.           {$Endif}
  1138.           WriteLn;
  1139.           if not Debug then
  1140.           Begin
  1141.                WriteLn;
  1142.                {$Ifdef ENGLISH}
  1143.                WriteLn('AF looks all over the disks through archives created by Arj, PkZip, Lha,');
  1144.                WriteLn('LhArc, PkArc/PkPak, Arc, Zoo, StuffIt and Tpz for the specified masks.');
  1145.                WriteLn('Exemples: AF *.DOC >MyFile.lst     Result is in "MYFILE.LST"');
  1146.                WriteLn('          AF *.DOC /gmFREE*.ZIP    Only looks in FREE*.ZIP archives');
  1147.                WriteLn('          AF *.DOC /rC:\UTIL       Start searching in C:\Util');
  1148.                WriteLn('          AF -cgmDOC.ZIP -tC       Shows true size after unpacking on C:');
  1149.                {$ELSE}
  1150.                WriteLn('AF cherche sur tout le disque dans les archives créées par Arj, PkZip, Lha,');
  1151.                WriteLn('LhArc, PkArc/PkPak, Arc, Zoo, StuffIt et Tpz le masque spécifié.');
  1152.                WriteLn('Exemples: AF *.DOC >Fichier.lst    le résultat est dans "FICHIER.LST"');
  1153.                WriteLn('          AF *.DOC /gmFREE*.ZIP    recherche dans les FREE*.ZIP seulement');
  1154.                WriteLn('          AF *.DOC /rC:\UTIL       commencer la recherche à C:\Util');
  1155.                WriteLn('          AF -cgmDOC.ZIP -tC       affiche la taille décompactée sur C:');
  1156.                {$Endif}
  1157.           End else
  1158.           Begin
  1159.                {$IfDef English}
  1160.                Write('Mask(s):            ');
  1161.                {$else}
  1162.                Write('Masque(s):          ');
  1163.                {$Endif}
  1164.                For i:=1 to NbMasques do Write('»'+Justify(Mask[i],16)+'«  ');
  1165.           End;
  1166.           Halt;
  1167.      End;
  1168.      if Stupid then Halt(1);
  1169. End;
  1170.  
  1171.  
  1172. {$F+} Procedure MyExitProc; {$F-}
  1173. Var c:String[1];
  1174.     s:String;
  1175. Begin
  1176.      LowVideo;
  1177.      if Redirige or not EcrireToutesA then
  1178.      Begin
  1179.           Write(CrtS,^M); ClrEol;
  1180.      End;
  1181.      if Redirige then WriteLn(CrtS);
  1182.      if AffTotaux then
  1183.        if ArchivesSeules then Begin
  1184.          if NbArcFound>0 then c:='s' else c:='';
  1185.          {$IfDef English}
  1186.          WriteLn(NbArcFound:4,' archive'+c+' found.');
  1187.          {$Else}
  1188.          WriteLn(NbArcFound:4,' archive'+c+' trouvée'+c+'.');
  1189.          {$Endif}
  1190.        End else Begin
  1191.          if NumD>0 then
  1192.          Begin
  1193.               if NumD>1 then c:='s' else c:='';
  1194.               if TotDskR>0 then Begin Str(TotDskR div 1024,s); s:='('+s+' '+MotKo+')'; End
  1195.                            else s:='';
  1196.               {$IfDef English}
  1197.               WriteLn(NumD:4,' ',Justify('file'+c+' on disk',23),TotDsk:8,' bytes ',s);
  1198.               {$Else}
  1199.               WriteLn(NumD:4,' ',Justify('fichier'+c+' sur le disque',23),TotDsk:8,' oct ',s);
  1200.               {$Endif}
  1201.          End;
  1202.          if NumA>0 then
  1203.          Begin
  1204.               if NumA>1 then c:='s' else c:='';
  1205.               if TotArcR>0 then Begin Str(TotArcR div 1024,s); s:=Justify('('+s+' '+motKo+')',10); End
  1206.                            else s:='          ';
  1207.               {$IfDef English}
  1208.               Write(NumA:4,' ',Justify('archived file'+c,23),TotArc:8,' bytes ',s,'    ');
  1209.               {$Else}
  1210.               Write(NumA:4,' ',Justify('fichier'+c+' archivé'+c,23),TotArc:8,' oct ',s,'    ');
  1211.               {$endif}
  1212.               if NbArch=1 then c:='' else c:='s';
  1213.               Write(NbArch,' archive'+c);
  1214.               WriteLn;
  1215.          End;
  1216.        End;
  1217.      if not ArchivesSeules then if not ((NumD<>0) xor (NumA<>0)) then
  1218.      Begin
  1219.           if TotalFound=0 then {$IfDef English} WriteLn('No file found.') else
  1220.                                {$Else} WriteLn('Aucun fichier trouvé.') else {$Endif}
  1221.           Begin
  1222.                if TotalFound=1 then c:='' else c:='s';
  1223.                {$IfDef English}
  1224.                Write(TotalFound:4,' ',Justify('file'+c+' found'+c,23));
  1225.                {$Else}
  1226.                Write(TotalFound:4,' ',Justify('fichier'+c+' trouvé'+c,23));
  1227.                {$Endif}
  1228.                if AffTotaux then
  1229.                Begin
  1230.                     if TotDskR+TotArcR>0
  1231.                        then Begin Str((TotDskR+TotArcR) div 1024,s); s:='('+s+' '+motKo+')'; End
  1232.                        else s:='';
  1233.                     {$IfDef English}
  1234.                     WriteLn(TotDsk+TotArc:8,' bytes ',s);
  1235.                     {$Else}
  1236.                     WriteLn(TotDsk+TotArc:8,' oct ',s);
  1237.                     {$Endif}
  1238.                End;
  1239.                WriteLn;
  1240.           End;
  1241.      End;
  1242.      ChDir(RepOriginal); Close(CrtS); Dispose(Fichiers);
  1243.      ExitProc:=KeepExit;
  1244.      if PatcherIci='' then; {juste pour être dans le code de l'executable}
  1245. End;
  1246.  
  1247.  
  1248. Var Lec:Byte;
  1249. Begin
  1250.      {$IfDef English}
  1251.      WriteLn('Archive Finder   1.25   Jc Boggio/France   Mar, 2 93   Public domain');
  1252.      {$Else}
  1253.      WriteLn('Archive Finder   1.25   Jc Boggio   2-Mar-93   Domaine public');
  1254.      {$Endif}
  1255.      Redirige:=Redir;
  1256.      LisParametres; WriteLn; Assign(OutPut,''); ReWrite(OutPut);
  1257.      AssignCrt(CrtS); ReWrite(CrtS); TotalFound:=0; New(Fichiers);
  1258.      TotDsk:=0; TotDskR:=0; TotArc:=0; TotArcR:=0; NumA:=0; NumD:=0; NbArcFound:=0;
  1259.      NbArch:=0; GetDir(0,RepOriginal); KeepExit:=ExitProc; ExitProc:=@MyExitProc;
  1260.      if Pos(':',DefRep)<>0 then Cherche(DefRep)
  1261.                            else For Lec:=1 to Length(Lecteurs) do
  1262.                                 Begin
  1263.                                      Pile:=0; {Normalement inutile}
  1264.                                      Cherche(Lecteurs[Lec]+':'+DefRep);
  1265.                                 End;
  1266. End.
  1267.  
  1268.  
  1269. - 1.00  Première version.
  1270.         Scrute les .LZH, les .ARJ, les .ZIP et les .ARC
  1271. - 1.01  Ajout des paramètres /S et /C
  1272. - 1.02  Ajout des fichiers .PAK
  1273.         Accélération de la recherche (50% plus rapide en moyenne, très efficace
  1274.         sur les grosses archives (utilisation du Seek, merci Etche)).
  1275.         Gère la redirection.
  1276.         Ajout du /E /M /A et /N
  1277.         Amélioration de la recherche par défaut
  1278. - 1.03  Suppression du bug lorsqu'aucun paramètre n'est spécifié
  1279.         Possibilité de remplacer le '/' par un '-'
  1280.         Ajout du /G /P et /R
  1281.         Modification du /S
  1282. - 1.04  Ajout des .ZOO (Merci Mr Burns (l'auteur de PibCat))
  1283.         Ajout du /W (merci Mr Buerg (l'auteur de FV entre autres))
  1284. - 1.05  Correction de l'affichage lors d'un /G seul (sans /P)
  1285. - 1.06  Ajout de totaux sur les archives
  1286.         Ajout de quelques ProcessKey pour mieux gérer <Espace>, <Ctrl-C> et <Esc>
  1287.         Amélioration du /C : si un répertoire par défaut est précisé on
  1288.                              remplace le /C par un /S
  1289.         Amélioration du /M : si le masque d'archives est précédé d'un chemin,
  1290.                              celui-ci est placé dans le /R
  1291.         Suppression des '\' final dans les noms de répertoire (c'est plus beau)
  1292.         possibilité de regrouper les paramètres (af -gp par exemple)
  1293.         possibilité de spécifier la valeur + ou - d'un paramètre (af -G+S-)
  1294.         Ajout de certains .SIT (très incertain !)
  1295. - 1.07  Modification mineure du /M pour raison de commodité
  1296.         Ajout du /T et /F
  1297. - 1.08  Ajout du /U et du /#
  1298.         Modification du /E pour inclure l'écriture des répertoires
  1299.         Réparation du /R si rien n'est précisé.
  1300.         Multiples modifications dans l'affichage en particulier pour la
  1301.         gestion de la redirection.
  1302. - 1.09  Accélération des recherches de 28%. Quand on voit la vitesse de
  1303.         "Supersonic Search Tools" on prend peur...
  1304. - 1.10  Accélération des recherches avec la recherche supersonique. 43% par
  1305.         rapport à la version 1.08
  1306.         Ajout du /B
  1307. - 1.11  La recherche supersonique ne pouvant chercher qu'à partir du
  1308.         répertoire \ et posant un problème avec le dos 4.01, elle est
  1309.         laissée de côté pour le moment.
  1310.         Remis en place l'usage de ProcessKey
  1311. - 1.12  Suppression définitive de la recherche supersonique.
  1312.         Suppression du /B
  1313.         Amélioration de la vitesse de 20%
  1314. - 1.13  Ajout de la recherche ultra rapide utilisée par SST (l'ex référence)
  1315.         qui peut ne chercher que les répertoires *.
  1316.         Ici, cette fonction n'est utile qu'en conjonction avec -g et -p
  1317.         (recherche globale, pas dans les archives). Mais elle est TRES utile.
  1318.         SST est dépassé. Essayez AF -GP* *.ZZZ
  1319.         Ajout du /*
  1320. - 1.14  Ajout des masques étendus de 4DOS ! (AF *A*F*.*)
  1321. - 1.15  Ajout de la recherche sur la date et la taille
  1322.         Ajout du /D et /I
  1323. - 1.16  Correction du bug en cas de tentative d'accès à une archive ReadOnly
  1324.         {Fin de la doc}
  1325. - 1.17  Correction mineure pour l'affichage des archives seules >= 10Mo.
  1326.         Multi masques !!! (AF *.Zip *.doc *.pas ...)
  1327.         Possibilité de lancer : AF \dos\*.com -gp
  1328.         A ce stade, on ne peut plus comparer les performances avec les
  1329.         autres produits (Multi masques + masques étendus)
  1330. - 1.18  Compatibilité avec MsDos 5.0 : modification de "ClusterSize".
  1331.         Gère la nouvelle méthode de compression de PkZip "Extra". Bof...
  1332. - 1.19  Correction mineure pour l'affichage /Wide
  1333.         Ajout du /L
  1334.         Pile économisée pendant la recherche des fichiers du disque
  1335.         Ajout du /B (pas la recherche supersonique mais le "Bel affichage")
  1336.         Modifications diverses d'affichage des totaux.
  1337.         /F détermine à présent si il faut afficher les totaux.
  1338.         /G est désormais par défaut sur + !!!
  1339.         Une seule diffusion
  1340. - 1.20  Encore quelques corrections et large diffusion
  1341. - 1.21  Ajout des fichiers TPZ de Patrick TEIL (merci à lui)
  1342.         Amélioration de ProcessKey
  1343.         Léger changement de look pour le contenu des archives
  1344.         Améliorations de Check. Gains de vitesse.
  1345.         Ajout de l'option /) pour VOIR ce que l'on cherche à faire et
  1346.         trouver une erreur
  1347. - 1.22  Les fichiers .A00 à .A99 sont considérés comme des archives ARJ
  1348.         La recherche de fichier dans une archive ne prend plus en compte
  1349.         le sous-répertoire dans lequel se trouve le fichier (jusque là,
  1350.         pour trouver le fichier UTIL\FICHIER.EXT, AF FICHIER* ne
  1351.         fonctionnait pas. Il fallait faire AF *FICHIER*
  1352.         La recherche accepte désormais les masques terminés par un . utile si
  1353.         l'on cherche les fichiers ne portant pas d'extension.
  1354. - 1.23  Debug du -m qui acceptait mal les -mb:xxx
  1355.         Les options /L /M et /R sont correctement affichées par l'option -)
  1356.         Modifications du /a en combinaison avec un masque de fichiers et
  1357.         combinaison avec /f et /n.
  1358.         TRES UTILE notamment pour :
  1359.           AF -AN TEASER.COM >FIC
  1360.           For %a in (@FIC) do Arj d %a teaser.com
  1361.  
  1362.           Ce petit Alias/Batch pour 4Dos fait chercher à AF toutes les
  1363.           archives contenant le fichier TEASER.COM et range cette liste
  1364.           dans FIC. Il ne reste plus qu'à dire à 4Dos de lire ce fichier
  1365.           FIC et pour chaque nom d'archive de supprimer le fichier en question.
  1366.  
  1367.         Correction sur le -C qui désormais fait un -L0 automatiquement
  1368.  
  1369. - 1.24  Création de la version en langue anglaise (non diffusée)
  1370. - 1.25  Corrections diverses langue anglaise
  1371.         Meilleure gestion des "garbages" à la fin des .LZH
  1372.         Changement de nom de la méthode de compactage "Deflat" pour PkZip
  1373.         (anciennement "Extra compression")
  1374.  
  1375. Pseudo CAT sur 3614 Teaser et 3615 Legend
  1376.                               3614 192310084
  1377.  
  1378.         Je cherche les formats de tous les Headers des .SIT (les vieux et les
  1379.         nouveaux !) ainsi que des .CPT
  1380.         Si vous avez des idées d'options à rajouter, je suis ouvert,
  1381.         n'hésitez surtout pas !
  1382.